home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 41 / Amiga Format CD41 (1999-06)(Future Publishing)(GB)[!][issue 1999-07].iso / -seriously_amiga- / programming / other / scm / slib / debug.scm < prev    next >
Text File  |  1999-04-19  |  2KB  |  81 lines
  1. ;;;; "debug.scm" Utility functions for debugging in Scheme.
  2. ;;; Copyright (C) 1991, 1992, 1993, 1995 Aubrey Jaffer.
  3. ;
  4. ;Permission to copy this software, to redistribute it, and to use it
  5. ;for any purpose is granted, subject to the following restrictions and
  6. ;understandings.
  7. ;
  8. ;1.  Any copy made of this software must include this copyright notice
  9. ;in full.
  10. ;
  11. ;2.  I have made no warrantee or representation that the operation of
  12. ;this software will be error-free, and I am under no obligation to
  13. ;provide any services, by way of maintenance, update, or otherwise.
  14. ;
  15. ;3.  In conjunction with products arising from the use of this
  16. ;material, there shall be no use of my name in any advertising,
  17. ;promotional, or sales literature without prior written consent in
  18. ;each case.
  19.  
  20. (require 'trace)
  21. (require 'break)
  22. (require 'line-i/o)
  23.  
  24. (define (for-each-top-level-definition-in-file file proc)
  25.   (call-with-input-file
  26.       file
  27.     (lambda (port)
  28.       (letrec
  29.       ((walk
  30.         (lambda (exp)
  31.           (cond
  32.            ((not (and (pair? exp) (list? exp))))
  33.            ((not (symbol? (car exp))))
  34.            (else
  35.         (case (car exp)
  36.           ((begin) (for-each walk (cdr exp)))
  37.           ((cond)  (for-each
  38.                 (lambda (exp)
  39.                   (for-each walk
  40.                     (if (list? (car exp)) exp (cdr exp))))
  41.                 (cdr exp)))
  42.           ((if)    (for-each
  43.                 walk
  44.                 (if (list? (cadr exp)) (cdr exp) (cddr exp))))
  45.           ((defmacro define-syntax) "should do something clever here")
  46.           ((define)
  47.            (proc exp))))))))
  48.     (if (eqv? #\# (peek-char port))
  49.         (read-line port))        ;remove `magic-number'
  50.     (do ((form (read port) (read port)))
  51.         ((eof-object? form))
  52.       (walk form))))))
  53.  
  54. (define (for-each-top-level-defined-procedure-symbol-in-file file proc)
  55.   (letrec ((get-defined-symbol
  56.         (lambda (form)
  57.           (if (pair? form)
  58.           (get-defined-symbol (car form))
  59.           form))))
  60.     (for-each-top-level-definition-in-file
  61.      file
  62.      (lambda (form) (let ((sym (get-defined-symbol (cadr form))))
  63.               (cond ((procedure? (slib:eval sym))
  64.                  (proc sym))))))))
  65.  
  66. (define (debug:trace-all file)
  67.   (for-each-top-level-defined-procedure-symbol-in-file
  68.    file
  69.    (lambda (sym)
  70.      (slib:eval `(set! ,sym (trace:tracef ,sym ',sym))))))
  71.  
  72. (define trace-all debug:trace-all)
  73.  
  74. (define (debug:break-all file)
  75.   (for-each-top-level-defined-procedure-symbol-in-file
  76.    file
  77.    (lambda (sym)
  78.      (slib:eval `(set! ,sym (break:breakf ,sym ',sym))))))
  79.  
  80. (define break-all debug:break-all)
  81.